/* REXX _port_summary.zrx by the reverend (build 108)                         */
/*-       built by rev-builder version 1.1 on 03 Jan 2003 at 13:31:08        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  first used in uso 2001, this script checks your cim data for */
/*               ports that are upgraded for megarob, and creates a report of */
/*               them all in order by when they will be ready to buydown      */
/*               again. you can post this report to a corp memo automatically.*/
/* rev. 0 - initial release                                                   */

call zoctimeout 120
call zocsynctime 500
globals=_setglobals()
call on halt name _halt
call zockeyboard "LOCK"

pmpt=_pcheck("Command [;Citadel command")
select
 when pmpt=0 then call _error "please start at the command prompt or citadel prompt."
 when pmpt=1 then do
  wait1="Command ["
  corpkey="t"
 end /*when*/
 when pmpt=2 then do
  wait1="Citadel command"
  corpkey="x"
 end /*when*/
end /*select*/

call _newline _ansi("bt;fgr")
parse value _getgameinfo() with spath ";" iname ";" game
parse value _getloginfo() with lpath ";" ldefault

ns=_ini_askint("how many sectors in this game?", 5000, iname, game, "ns")
if ns<1 | ns>20000 then call _error "number out of range"
cname=_ini_askstr("enter cim filename (no extension):", "cim", iname, game, "cim")
if cname="" then call _error "script cancelled by user."
regen=_ini_asknum("how much does a port regen in a day?", 100, iname, game, "production_rate")
max=_ini_askint("what is max port amount?", 32760, iname, game, "port_max")

max1=3000
max2=(max%100)*100

time=_getservertime("minutes")

cutoff.=""
cutoff.1=100
cutoff.2=95
cutoff.3=90
cutoff.4=80
cutoff.5=70
cutoff.6=60
cutoff.7=50
cutoff.8=0

buyequ.=""
sellequ.=""
buyorg.=""
sellorg.=""
buyore.=""
sellore.=""

bbb=""
bbs=""
bsb=""
bss=""
sbb=""
sbs=""
ssb=""
sss=""

if _yesno("refresh cim data?") then call _logcim lpath, cname, "portcim", ldefault
call _loadportcim lpath||cname||".prt"

do sector=1 to ns
 if _p.sector\="" then do
  parse var _p.sector type ";" ore "," pore ";" org "," porg ";" equ "," pequ

  ore=abs(ore)
  org=abs(org)
  equ=abs(equ)

  if pore>0 then more=trunc(ore/pore)*100
  else more=trunc(ore/.9)*100
  if porg>0 then morg=trunc(org/porg)*100
  else morg=trunc(org/.9)*100
  if pequ>0 then mequ=trunc(equ/pequ)*100
  else mequ=trunc(equ/.9)*100

  if more>max then more=max
  if morg>max then morg=max
  if mequ>max then mequ=max

  if mequ>=max2 & right(type,1)="B" then do
   i=1
   done=0
   do while \done
    if pequ>=cutoff.i then do
     if i>1 & i<=3 then do
      ready=trunc((1-(equ/mequ))*(100/regen)*24*60)+time
      hrs=trunc(ready/60)
      mins=trunc((ready/60-hrs)*60)
      if mins<10 then mins="0"||mins
      if hrs>24 then hrs=hrs-24
      buyequ.i=buyequ.i||sector||"-"||hrs||":"||mins||" "
     end /*if*/
     else buyequ.i=buyequ.i||sector||" "
     done=1
    end /*if*/
    else i=i+1
   end /*do*/
  end /*if*/

  if mequ>=max2 & right(type,1)="S" then do
   i=1
   done=0
   do while \done
    if pequ>=cutoff.i then do
     if i>1 & i<=3 then do
      ready=trunc((1-(equ/mequ))*(100/regen)*24*60)+time
      hrs=trunc(ready/60)
      mins=trunc((ready/60-hrs)*60)
      if mins<10 then mins="0"||mins
      if hrs>24 then hrs=hrs-24
      sellequ.i=sellequ.i||sector||"-"||hrs||":"||mins||" "
     end /*if*/
     else sellequ.i=sellequ.i||sector||" "
     done=1
    end /*if*/
    else i=i+1
   end /*do*/
  end /*if*/

  if morg>=max2 & substr(type,2,1)="B" then do
   i=1
   done=0
   do while \done
    if porg>=cutoff.i then do
     if i>1 & i<=3 then do
      ready=trunc((1-(org/morg))*(100/regen)*24*60)+time
      hrs=trunc(ready/60)
      mins=trunc((ready/60-hrs)*60)
      if mins<10 then mins="0"||mins
      if hrs>24 then hrs=hrs-24
      buyorg.i=buyorg.i||sector||"-"||hrs||":"||mins||" "
     end /*if*/
     else buyorg.i=buyorg.i||sector||" "
     done=1
    end /*if*/
    else i=i+1
   end /*do*/
  end /*if*/

  if morg>=max2 & substr(type,2,1)="S" then do
   i=1
   done=0
   do while \done
    if porg>=cutoff.i then do
     if i>1 & i<=3 then do
      ready=trunc((1-(org/morg))*(100/regen)*24*60)+time
      hrs=trunc(ready/60)
      mins=trunc((ready/60-hrs)*60)
      if mins<10 then mins="0"||mins
      if hrs>24 then hrs=hrs-24
      sellorg.i=sellorg.i||sector||"-"||hrs||":"||mins||" "
     end /*if*/
     else sellorg.i=sellorg.i||sector||" "
     done=1
    end /*if*/
    else i=i+1
   end /*do*/
  end /*if*/

  if more>=max2 & left(type,1)="B" then do
   i=1
   done=0
   do while \done
    if pore>=cutoff.i then do
     if i>1 & i<=3 then do
      ready=trunc((1-(ore/more))*(100/regen)*24*60)+time
      hrs=trunc(ready/60)
      mins=trunc((ready/60-hrs)*60)
      if mins<10 then mins="0"||mins
      if hrs>24 then hrs=hrs-24
      buyore.i=buyore.i||sector||"-"||hrs||":"||mins||" "
     end /*if*/
     else buyore.i=buyore.i||sector||" "
     done=1
    end /*if*/
    else i=i+1
   end /*do*/
  end /*if*/

  if more>=max2 & left(type,1)="S" then do
   i=1
   done=0
   do while \done
    if pore>=cutoff.i then do
     if i>1 & i<=3 then do
      ready=trunc((1-(ore/more))*(100/regen)*24*60)+time
      hrs=trunc(ready/60)
      mins=trunc((ready/60-hrs)*60)
      if mins<10 then mins="0"||mins
      if hrs>24 then hrs=hrs-24
      sellore.i=sellore.i||sector||"-"||hrs||":"||mins||" "
     end /*if*/
     else sellore.i=sellore.i||sector||" "
     done=1
    end /*if*/
    else i=i+1
   end /*do*/
  end /*if*/

  select
   when type="BBB" then do
    pstr=""
    if more>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if morg>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if mequ>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if more>max1 | morg>max1 | mequ>max1 then bbb=bbb||sector||"-"||pstr||" "
   end /*when*/
   when type="BBS" then do
    pstr=""
    if more>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if morg>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if mequ>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if more>max1 | morg>max1 | mequ>max1 then bbs=bbs||sector||"-"||pstr||" "
   end /*when*/
   when type="BSB" then do
    pstr=""
    if more>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if morg>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if mequ>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if more>max1 | morg>max1 | mequ>max1 then bsb=bsb||sector||"-"||pstr||" "
   end /*when*/
   when type="BSS" then do
    pstr=""
    if more>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if morg>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if mequ>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if more>max1 | morg>max1 | mequ>max1 then bss=bss||sector||"-"||pstr||" "
   end /*when*/
   when type="SBB" then do
    pstr=""
    if more>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if morg>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if mequ>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if more>max1 | morg>max1 | mequ>max1 then sbb=sbb||sector||"-"||pstr||" "
   end /*when*/
   when type="SBS" then do
    pstr=""
    if more>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if morg>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if mequ>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if more>max1 | morg>max1 | mequ>max1 then sbs=sbs||sector||"-"||pstr||" "
   end /*when*/
   when type="SSB" then do
    pstr=""
    if more>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if morg>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if mequ>=max2 then pstr=pstr||"B"
    else pstr=pstr||"b"
    if more>max1 | morg>max1 | mequ>max1 then ssb=ssb||sector||"-"||pstr||" "
   end /*when*/
   when type="SSS" then do
    pstr=""
    if more>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if morg>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if mequ>=max2 then pstr=pstr||"S"
    else pstr=pstr||"s"
    if more>max1 | morg>max1 | mequ>max1 then sss=sss||sector||"-"||pstr||" "
   end /*when*/
   otherwise nop
  end /*select*/

 end /*if*/

end /*do*/

call _fileclose(fname)

call zocwriteln _ansi("bt;fwh")
call _notice 70, "general report:"
call _notice 70, "BBB - "||bbb
call _notice 70, "BBS - "||bbs
call _notice 70, "BSB - "||bsb
call _notice 70, "BSS - "||bss
call _notice 70, "SBB - "||sbb
call _notice 70, "SBS - "||sbs
call _notice 70, "SSB - "||ssb
call _notice 70, "SSS - "||sss
call _notice 70, "."

call _notice 70, "equipment buydown (xxS) report:"
i=1
do while cutoff.i>0
 if sellequ.i\="" then call _notice 70, ">"||cutoff.i||"% - "||sellequ.i
 i=i+1
end /*do*/
j=i-1
if sellequ.i\="" then call _notice 70, "<"||cutoff.j||"% - "||sellequ.i
call _notice 70, "."

call _notice 70, "organics buydown (xSx) report:"
i=1
do while cutoff.i>0
 if sellorg.i\="" then call _notice 70, ">"||cutoff.i||"% - "||sellorg.i
 i=i+1
end /*do*/
j=i-1
if sellorg.i\="" then call _notice 70, "<"||cutoff.j||"% - "||sellorg.i
call _notice 70, "."

call _notice 70, "fuel ore buydown (Sxx) report:"
i=1
do while cutoff.i>0
 if sellore.i\="" then call _notice 70, ">"||cutoff.i||"% - "||sellore.i
 i=i+1
end /*do*/
j=i-1
if sellore.i\="" then call _notice 70, "<"||cutoff.j||"% - "||sellore.i
call _notice 70, "."

call _notice 70, "equipment selloff (xxB) report:"
i=1
do while cutoff.i>0
 if buyequ.i\="" then call _notice 70, ">"||cutoff.i||"% - "||buyequ.i
 i=i+1
end /*do*/
j=i-1
if buyequ.i\="" then call _notice 70, "<"||cutoff.j||"% - "||buyequ.i
call _notice 70, "."

call _notice 70, "organics selloff (xBx) report:"
i=1
do while cutoff.i>0
 if buyorg.i\="" then call _notice 70, ">"||cutoff.i||"% - "||buyorg.i
 i=i+1
end /*do*/
j=i-1
if buyorg.i\="" then call _notice 70, "<"||cutoff.j||"% - "||buyorg.i
call _notice 70, "."

call _notice 70, "fuel ore selloff (Bxx) report:"
i=1
do while cutoff.i>0
 if buyore.i\="" then call _notice 70, ">"||cutoff.i||"% - "||buyore.i
 i=i+1
end /*do*/
j=i-1
if buyore.i\="" then call _notice 70, "<"||cutoff.j||"% - "||buyore.i
call zocwriteln _ansi("fmg")

if _yesno("leave corp memo?") then do
 call zocsend corpkey||"t"
 if zocwait("C:")=640 then call _error "timeout"

 call zocsend " / \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \^M"
 call zocsend " / \/ \/ \/ \/ \/   the re\/erend's port summary   \/ \/ \/ \/ \/ \^M"
 call zocsend " / \/ \/ \/ \/ \/  (times listed are server time)  \/ \/ \/ \/ \/ \^M"
 call zocsend " / \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \^M"
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "general report:^M"
 hdr=" BBB - "
 do while bbb\=""
  if length(bbb)<=59 then k=length(bbb)
  else k=lastpos(" ",bbb,59)
  call zocsend hdr||strip(left(bbb,k))||"^M"
  bbb=strip(substr(bbb,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" BBS - "
 do while bbs\=""
  if length(bbs)<=59 then k=length(bbs)
  else k=lastpos(" ",bbs,59)
  call zocsend hdr||strip(left(bbs,k))||"^M"
  bbs=strip(substr(bbs,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" BSB - "
 do while bsb\=""
  if length(bsb)<=59 then k=length(bsb)
  else k=lastpos(" ",bsb,59)
  call zocsend hdr||strip(left(bsb,k))||"^M"
  bsb=strip(substr(bsb,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" BSS - "
 do while bss\=""
  if length(bss)<=59 then k=length(bss)
  else k=lastpos(" ",bss,59)
  call zocsend hdr||strip(left(bss,k))||"^M"
  bss=strip(substr(bss,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" SBB - "
 do while sbb\=""
  if length(sbb)<=59 then k=length(sbb)
  else k=lastpos(" ",sbb,59)
  call zocsend hdr||strip(left(sbb,k))||"^M"
  sbb=strip(substr(sbb,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" SBS - "
 do while sbs\=""
  if length(sbs)<=59 then k=length(sbs)
  else k=lastpos(" ",sbs,59)
  call zocsend hdr||strip(left(sbs,k))||"^M"
  sbs=strip(substr(sbs,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" SSB - "
 do while ssb\=""
  if length(ssb)<=59 then k=length(ssb)
  else k=lastpos(" ",ssb,59)
  call zocsend hdr||strip(left(ssb,k))||"^M"
  ssb=strip(substr(ssb,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 hdr=" SSS - "
 do while sss\=""
  if length(sss)<=59 then k=length(sss)
  else k=lastpos(" ",sss,59)
  call zocsend hdr||strip(left(sss,k))||"^M"
  sss=strip(substr(sss,k+1))
  hdr="       "
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "equipment buydown (xxS) report:^M"
 i=1
 do while cutoff.i>=0
  if sellequ.i\="" then do
   if length(sellequ.i)<=59 then k=length(sellequ.i)
   else k=lastpos(" ",sellequ.i,59)
   i1=i-1
   if cutoff.i=0 then call zocsend " <"||cutoff.i1||"%"||copies(" ",4-length(cutoff.i1))||"- "||strip(left(sellequ.i,k))||"^M"
   else call zocsend " >"||cutoff.i||"%"||copies(" ",4-length(cutoff.i))||"- "||strip(left(sellequ.i,k))||"^M"
   sellequ.i=strip(substr(sellequ.i,k+1))
   do while sellequ.i\=""
    if length(sellequ.i)<=59 then k=length(sellequ.i)
    else k=lastpos(" ",sellequ.i,59)
    call zocsend "         "||strip(left(sellequ.i,k))||"^M"
    sellequ.i=strip(substr(sellequ.i,k+1))
   end /*do*/
  end /*if*/
  i=i+1
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "organics buydown (xSx) report:^M"
 i=1
 do while cutoff.i>=0
  if sellorg.i\="" then do
   if length(sellorg.i)<=59 then k=length(sellorg.i)
   else k=lastpos(" ",sellorg.i,59)
   i1=i-1
   if cutoff.i=0 then call zocsend " <"||cutoff.i1||"%"||copies(" ",4-length(cutoff.i1))||"- "||strip(left(sellorg.i,k))||"^M"
   else call zocsend " >"||cutoff.i||"%"||copies(" ",4-length(cutoff.i))||"- "||strip(left(sellorg.i,k))||"^M"
   sellorg.i=strip(substr(sellorg.i,k+1))
   do while sellorg.i\=""
    if length(sellorg.i)<=59 then k=length(sellorg.i)
    else k=lastpos(" ",sellorg.i,59)
    call zocsend "         "||strip(left(sellorg.i,k))||"^M"
    sellorg.i=strip(substr(sellorg.i,k+1))
   end /*do*/
  end /*if*/
  i=i+1
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "fuel ore buydown (Sxx) report:^M"
 i=1
 do while cutoff.i>=0
  if sellore.i\="" then do
   if length(sellore.i)<=59 then k=length(sellore.i)
   else k=lastpos(" ",sellore.i,59)
   i1=i-1
   if cutoff.i=0 then call zocsend " <"||cutoff.i1||"%"||copies(" ",4-length(cutoff.i1))||"- "||strip(left(sellore.i,k))||"^M"
   else call zocsend " >"||cutoff.i||"%"||copies(" ",4-length(cutoff.i))||"- "||strip(left(sellore.i,k))||"^M"
   sellore.i=strip(substr(sellore.i,k+1))
   do while sellore.i\=""
    if length(sellore.i)<=59 then k=length(sellore.i)
    else k=lastpos(" ",sellore.i,59)
    call zocsend "         "||strip(left(sellore.i,k))||"^M"
    sellore.i=strip(substr(sellore.i,k+1))
   end /*do*/
  end /*if*/
  i=i+1
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "equipment selloff (xxB) report:^M"
 i=1
 do while cutoff.i>=0
  if buyequ.i\="" then do
   if length(buyequ.i)<=59 then k=length(buyequ.i)
   else k=lastpos(" ",buyequ.i,59)
   i1=i-1
   if cutoff.i=0 then call zocsend " <"||cutoff.i1||"%"||copies(" ",4-length(cutoff.i1))||"- "||strip(left(buyequ.i,k))||"^M"
   else call zocsend " >"||cutoff.i||"%"||copies(" ",4-length(cutoff.i))||"- "||strip(left(buyequ.i,k))||"^M"
   buyequ.i=strip(substr(buyequ.i,k+1))
   do while buyequ.i\=""
    if length(buyequ.i)<=59 then k=length(buyequ.i)
    else k=lastpos(" ",buyequ.i,59)
    call zocsend "         "||strip(left(buyequ.i,k))||"^M"
    buyequ.i=strip(substr(buyequ.i,k+1))
   end /*do*/
  end /*if*/
  i=i+1
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "organics selloff (xBx) report:^M"
 i=1
 do while cutoff.i>=0
  if buyorg.i\="" then do
   if length(buyorg.i)<=59 then k=length(buyorg.i)
   else k=lastpos(" ",buyorg.i,59)
   i1=i-1
   if cutoff.i=0 then call zocsend " <"||cutoff.i1||"%"||copies(" ",4-length(cutoff.i1))||"- "||strip(left(buyorg.i,k))||"^M"
   else call zocsend " >"||cutoff.i||"%"||copies(" ",4-length(cutoff.i))||"- "||strip(left(buyorg.i,k))||"^M"
   buyorg.i=strip(substr(buyorg.i,k+1))
   do while buyorg.i\=""
    if length(buyorg.i)<=59 then k=length(buyorg.i)
    else k=lastpos(" ",buyorg.i,59)
    call zocsend "         "||strip(left(buyorg.i,k))||"^M"
    buyorg.i=strip(substr(buyorg.i,k+1))
   end /*do*/
  end /*if*/
  i=i+1
 end /*do*/
 call zocsend "."
 if zocwait(".")=640 then call _error "timeout"
 call zocsend "^(08)"

 call zocsend "fuel ore selloff (Bxx) report:^M"
 i=1
 do while cutoff.i>=0
  if buyore.i\="" then do
   if length(buyore.i)<=59 then k=length(buyore.i)
   else k=lastpos(" ",buyore.i,59)
   i1=i-1
   if cutoff.i=0 then call zocsend " <"||cutoff.i1||"%"||copies(" ",4-length(cutoff.i1))||"- "||strip(left(buyore.i,k))||"^M"
   else call zocsend " >"||cutoff.i||"%"||copies(" ",4-length(cutoff.i))||"- "||strip(left(buyore.i,k))||"^M"
   buyore.i=strip(substr(buyore.i,k+1))
   do while buyorg.i\=""
    if length(buyore.i)<=59 then k=length(buyore.i)
    else k=lastpos(" ",buyore.i,59)
    call zocsend "         "||strip(left(buyore.i,k))||"^M"
    buyore.i=strip(substr(buyore.i,k+1))
   end /*do*/
  end /*if*/
  i=i+1
 end /*do*/

 call zocsend " / \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \^M"
 call zocsend " / \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \^M"

 call zocsend "^Mq"
 if zocwait(wait1)=640 then call _error "timeout"

end /*if*/
else nop

call _quit
exit

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _getgameinfo v.5 **/
    _getgameinfo: procedure expose (globals)
     spath=_getscriptpath()
     base=spath||"script.ini"
    
     if arg(1,"E") then fname=arg(1)
     else fname=base
    
     parse value zocgetglobaloption("WindowTitle") with . '="' game '"'
     if fname\=base | game="" | game="%ZOCORHOST% %OPTIONS%" then do
      list=_ini_getheadings(fname)
      if list="##EOF##" then game="##EOF##"
      else do
       templist=""
       do i=1 to _dwords(list,";")
        temp=_dword(list,i,";")
        if left(temp,1)\="*" then do
         if templist="" then templist=temp
         else templist=templist||";"||temp
        end /*if*/
       end /*do*/
       list=templist
       game=_drequestlist("select a game:", list, ";", "c")
      end /*else*/
     end /*do*/
    
     call zocwrite _ansi("bt;fgr")||"< using "
     if length(fname)>17 then call zocwrite "..."
     call zocwriteln right(fname,min(length(fname),17))||" - ["||game||"] >"
    
     rslt=spath||";"||fname||";"||game
    return rslt

/** _getloginfo v.2 **/
    _getloginfo: procedure expose (globals)
     parse value zocgetoption("CaptDefaultName") with . '="' ldefault '"'
     parse value zocgetglobaloption("CapturePath") with . '="' lpath '"'
     lpath=dosfname(lpath)
     if right(lpath,1)\="\" then lpath=lpath||"\"
     if \dosisdir(lpath) then call _error "invalid path in _getloginfo"
     rslt=lpath||";"||ldefault
    return rslt

/** _ini_askint v.5 **/
    _ini_askint: procedure expose (globals)
     if \arg(1,"E") then msg="enter an integer"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askint"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if _stripint(default)\=default then call _error "invalid parameter in _ini_askint"
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripint(default)
      when rslt="##EOF##"                     then rslt=_askint(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then rslt=_stripint(rslt)
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >"
       rslt=_stripint(rslt)
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _ini_askstr v.5 **/
    _ini_askstr: procedure expose (globals)
     if \arg(1,"E") then msg="enter a number"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askstr"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=default
      when rslt="##EOF##"                     then rslt=_askstr(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then nop
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwrite right(fname,min(length(fname),17))||" - "
       call zocwrite key||"="||left(translate(rslt,"~","^"),min(length(rslt),25))
       if length(rslt)>25 then call zocwrite "..."
       call zocwriteln " >"
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _ini_asknum v.5 **/
    _ini_asknum: procedure expose (globals)
     if \arg(1,"E") then msg="enter a number"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_asknum"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if _stripnum(default)\=default then call _error "invalid parameter in _ini_askint"
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripnum(default)
      when rslt="##EOF##"                     then rslt=_asknum(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then rslt=_stripnum(rslt)
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >"
       rslt=_stripnum(rslt)
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _getservertime v.7 **/
    _getservertime: procedure expose (globals)
    
     /* get real date/time values */
        parse value date("N") with . . year
        parse value date("O") with . "/" month "/" day
        sod=time("S")
        doy=date("D")
        base=date("B")
        parse value time("N") with hr ":" mn ":" sc
        leapyear=abs((year//4=0)-1)
        base=base-_baseday.2000
        base_sec=base*86400+sod
    
     /* get game date/time values */
        if _g.!timediff="_G.!TIMEDIFF" then do
         if _sendwait("ct","(?=Help)? T")=640 then call _error "timeout"
         if zocwaitmux(", "||year+11, ", "||year+12, ", "||year+13)=640 then call _error "timeout"
         line=_lastline()
         call zocsend "q"
         parse var line g_hr ":" g_min ":" g_sec g_ampm . g_month g_day ", " g_year .
         g_year=g_year-12
         if g_ampm="PM" & g_hr\=12 then g_hr=g_hr+12
         g_month=lower(g_month)
         do i=12 to 1 by -1
          if g_month=_dword(_monthnames,i,";") then leave
         end /*do*/
         g_month=i
         parse value _calc_base_date(g_year, g_month, g_day, g_hr, g_min, g_sec) with g_base ";" g_doy ";" g_sod ";" g_base_sec
         _g.!timediff=base_sec-g_base_sec
        end /*if*/
        else do
         g_base_sec=base_sec-_g.!timediff
         g_sod=g_base_sec//86400
         g_base=g_base_sec%86400
         do i=2000 to 2008
          if (_baseday.i-_baseday.2000)<=g_base then g_year=i
         end /*do*/
         g_doy=g_base-_baseday.g_year+_baseday.2000
        end /*else*/
    
     select
      when arg(1)="seconds"   then rslt=g_sod
      when arg(1)="minutes"   then rslt=g_sod%60
      when arg(1)="hours"     then rslt=g_sod%3600
      when arg(1)="stamp_old" then rslt=g_year-2000||copies("0",3-length(g_doy))||g_doy||copies("0",5-length(g_sod))||g_sod
      when arg(1)="stamp"     then rslt=g_base_sec
      otherwise                    rslt=g_base_sec
     end /*select*/
    return rslt

/** _yesno v.3 **/
    _yesno: procedure expose (globals)
     if arg(1,"E") then msg=arg(1)
     else msg="yes or no"
     if arg(2)="yn" then rslt=zocrequest(msg||" (ESC=no)", "yes", "no")
                    else rslt=zocrequest(msg, "yes", "no", "cancel")
     select
      when rslt="cancel" then call _quit "script cancelled by user.", "nocopy"
      when rslt="##CANCEL##" & arg(2)\="yn" then call _quit "script cancelled by user.", "nocopy"
      when rslt="yes" then rslt=1
      otherwise rslt=0
     end /*select*/
    return rslt

/** _logcim v.4 **/
    _logcim: procedure expose (globals)
    
     path=arg(1)
     fname=arg(2)
     tasks=arg(3)
     default=arg(4)
    
     if zocgetinfo("VERSION")>=4.03 then call zoclogging 0, 1
     else call zoclogging 0
     call zocsend "^^?"
     if zocwait("Interrogation Modes")=640 then call _error "timeout"
     if zocwait(":")=640 then call _error "timeout"
     call zocwriteln
     call zocrespond "[Pause]", " "
     call zoctimeout 60
    
     do while tasks\=""
    
      parse var tasks task ";" tasks
      select
       when task="portcim" then ext=".prt"
       when task="sectorcim" then ext=".sct"
       otherwise task=""
      end /*select*/
    
      if task\="" then do
       if _fileexists(path||fname||ext) then call dosdel path||fname||ext
       call zoclogname fname||ext
       call zoclogging 1, 1
       call zoctimeout 3000
       select
        when task="portcim" then call zocsend "r"
        when task="sectorcim" then call zocsend "i"
        otherwise nop
       end /*select*/
       if zocwait(":")=640 then call _error "timeout"
       call zoclogging 0, 1
      end /*if*/
    
     end /*do*/
    
     call zoctimeout 60
     call zocsend "q"
     if zocwait("ENDINTERROG")=640 then call _error "timeout"
     call zocrespond "[Pause]"
     call zoclogname default
     if zocgetinfo("VERSION")>=4.03 then call zoclogging 1, 1
     else call zoclogging 1
    
    return

/** _loadportcim v.6 **/
    _loadportcim: procedure expose (globals)
     fname=arg(1)
     _p.=""
     call _newline
     call zocwrite _ansi("bt;fcy")||"reading "||fname||" "
     if _fileopenr(fname) then do
      mon=0
      do while \_fileeof(fname)
       line=strip(linein(fname))
       parse var line row line
       if line\="" & row\="" then do
        line=_space(translate(line," ","%"))
        line=zocstring("REPLACE",line,"- ","-")
        line=word(line,1)||","||word(line,2)||";"||word(line,3)||","||word(line,4)||";"||word(line,5)||","||word(line,6)
        if _dword(_dword(line,1,";"),1,",")<0 then _p.row="B"
        else _p.row="S"
        if _dword(_dword(line,2,";"),1,",")<0 then _p.row=_p.row||"B"
        else _p.row=_p.row||"S"
        if _dword(_dword(line,3,";"),1,",")<0 then _p.row=_p.row||"B"
        else _p.row=_p.row||"S"
        _p.row=_p.row||";"||line
        mon=_spinner(mon,500)
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*if*/
     else call zocwrite "x"
    return

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _notice v.3 **/
    _notice: procedure expose (globals)
     width=arg(1)
     if width>75 then width=75
     line=arg(2)
    
     i=3
     do while arg(i)\=""
      nw1=length(arg(i))
      if nw1+width>250 then width=250-nw1
      i=i+1
     end /*do*/
     if width<20 then call _error "notice error"
    
     i=3
     do while length(line)>0
      if length(line)<=width & arg(i)\="" then do
       line=line||arg(i)
       i=i+1
      end /*if*/
      if length(line)<=width then do
       call zocwriteln "<< "||_pad(line,width,"L")||">>"
       line=""
      end /*if*/
      else do
       np=width
       do while substr(line,np,1)\=" "
        np=np-1
       end /*do*/
       call zocwriteln "<< "||_pad(left(line,np),width,"L")||">>"
       line=substr(line,np+1)
      end /*else*/
     end /*do*/
    return

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _getscriptpath v.1 **/
    _getscriptpath:
     parse value zocgetglobaloption("ScriptPath") with . '="' spath '"'
     spath=dosfname(spath)
     if right(spath,1)\="\" then spath=spath||"\"
     if \dosisdir(spath) then call _error "invalid path in _getscriptpath"
    return spath

/** _ini_getheadings v.5 **/
    _ini_getheadings: procedure expose (globals)
     if arg(1,"E") then fname=arg(1)
     else call _error "missing parameter in _ini_getheadings"
     if arg(2,"E") then delim=left(arg(2),1)
     else delim=";"
     list=""
     if _fileopenr(fname) then do
      do while \_fileeof(fname)
       line=strip(linein(fname))
       if left(line,1)="[" then do
        if list="" then list=strip(translate(line,"  ","[]"))
        else list=list||delim||strip(translate(line,"  ","[]"))
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*do*/
     if list="" then list="##EOF##"
    return list

/** _drequestlist v.3 **/
    _drequestlist: procedure expose (globals)
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     select
      when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
      when i<0 then rslt="##CANCEL##"
      otherwise rslt=_dword(arg(2),i+1,arg(3))
     end /*select*/
    return rslt

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt

/** _ini_read v.1 **/
    _ini_read: procedure expose (globals)
     /* argument check */
     do i=1 to 3
      if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_read."
     end /*do*/
    
     /* name arguments */
     fname=arg(1)
     s=strip(arg(2))
     k=strip(arg(3))
    
     if _fileopenr(fname) then do
      done=0
      found=0
      insection=0
      do while \done & \_fileeof(fname)
       line=strip(linein(fname))
       select
        when left(line,1)=";" then nop
        when line="["||s||"]" then insection=1
        when insection & left(line,1)="[" then done=1
        when insection & left(line,length(k)+1)=k||"=" then do
         v=strip(substr(line,length(k)+2))
         done=1
         found=1
        end /*when*/
        otherwise nop
       end /*select*/
      end /*do*/
      call _fileclose fname 
      if \found then v="##EOF##"
     end /*if*/
     else v="##EOF##"
    
    return v

/** _askint v.2 **/
    _askint: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an integer:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripint(rslt)\=rslt | rslt=""
      default=rslt||" [please enter an integer or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _askstr v.1 **/
    _askstr: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an string:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=zocask(msg, default)
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _stripnum v.3 **/
    _stripnum: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789."," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if _dwords(rslt,".")>2 then rslt=_dword(rslt,1,".")||"."||_space(translate(substr(rslt,pos(".",rslt)+1)," ","."),0)
     if \datatype(rslt,"N") then rslt=""
    return rslt

/** _asknum v.4 **/
    _asknum: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an number:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripnum(rslt)\=rslt | rslt=""
      default=rslt||" [please enter a number or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _sendwait v.1 **/
    _sendwait: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _sendwait"
     call zocsend arg(1)
     rslt=zocwait(arg(2))
     select
      when \arg(3,"E") | arg(3)=""             then nop
      when lower(arg(3))="timeout"  & rslt=640 then call _error "timeout"
      when lower(arg(3))="lastline" & rslt=640 then call _error "timeout"
      when lower(arg(3))="lastline"            then rslt=_lastline()
      otherwise nop
     end /*select*/
    return rslt

/** _lastline v.3 **/
    _lastline: procedure expose (globals)
     rslt=zoclastline()
     select
      when lower(arg(1))="raw" then nop
      when pos(d2c(7),rslt)>0  then rslt=translate(zocstring("REMOVE", rslt, d2c(7)),"  ",d2c(0)||d2c(10))
      otherwise                     rslt=translate(rslt,"  ",d2c(0)||d2c(10))
     end /*select*/
    return rslt

/** _calc_base_date v.3 **/
    /* v.3 tested */
    _calc_base_date: procedure expose (globals)
    
     yr=arg(1); mm=arg(2); dd=arg(3); hr=arg(4); mn=arg(5); sc=arg(6)
    
     /* leapyear? */
        leapyear=abs((yr//4=0)-1)
    
     /* day of year */
        doy=dd-1
        do i=1 to mm-1
         doy=doy+_dword(_monthdays,i,";")
        end /*do*/
        if mm>2 & leapyear then doy=doy+1
    
     /* base day since 2000 */
        base=_baseday.yr-_baseday.2000+doy
    
     /* seconds of day */
        sod=((hr*60)+mn)*60+sc
    
     /* base day in seconds */
        base_sec=base*86400+sod
    
     rslt=base||";"||doy||";"||sod||";"||base_sec
    
    return rslt

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt

/** _spinner v.3 **/
    _spinner: procedure expose (globals)
     if arg(1,"E") then count=arg(1)
                   else call _error "missing parameter in _spinner"
     if arg(2,"E") then width=arg(2)
                   else width=100
     if arg(3,"E") & length(arg(3))=5 then chs=arg(3)
                                      else chs="-\|/."
    /* bs="^H" */
     bs=d2c(27)||"[1D"
     select
      when count=-1        then call zocwrite bs||substr(chs,5,1)
      when count<0         then count=-1
      when count=0         then call zocwrite left(chs,1)
      when count=width     then call zocwrite bs||substr(chs,2,1)
      when count=(width*2) then call zocwrite bs||substr(chs,3,1)
      when count=(width*3) then call zocwrite bs||substr(chs,4,1)
      when count=(width*4) then do
       call zocwrite bs||left(chs,1)
       count=0
      end /*when*/
      otherwise nop
     end /*select*/
     count=count+1
    return count

/** _pad v.1 **/
    _pad: procedure expose (globals)
     rslt=arg(1)
     if arg(2,"E") then w=arg(2); else return rslt
     if \arg(3,"E") then m="L"; else m=arg(3)
     select
      when m="L" then rslt=left(rslt,w)
      when m="R" then rslt=reverse(left(reverse(rslt),w))
      when m="C" then rslt=center(rslt,w)
      otherwise       rslt=left(rslt,w)
     end /*select*/
    return rslt

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")\="NOTREADY" then rslt=1; else rslt=0
    return rslt